home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
input.zip
/
INPUTUN.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1993-01-04
|
7KB
|
261 lines
Unit InputUn;
{ This is a small unit with crash proof user input routines and some
string formating functions. Compile the DemoInput program for more
information on how to use these functions.
Robert Mashlan [71160,3067] 3/11/89 }
Interface
Uses Crt;
const
DefaultSet = [' '..'}'];
Var
InverseOn : boolean;
UpcaseOn : boolean;
ValidCharSet : set of char;
Procedure Inverse;
Procedure UnderLine;
Procedure Normal;
Procedure Goback;
Function ReadString( Prompt : string; Width : byte; var Escape : boolean ) : string;
Function ReadNum( Prompt : real; Width : byte; var Escape : boolean ) : real;
Function ReadInt( Prompt : longint; Width : byte; var Escape : boolean ) : longint;
Function Left( AnyString : string; Width : byte ) : string;
Function Center( AnyString : string; Width : byte ) : string;
Implementation
const
esc = #27;
Procedure Inverse;
begin
textbackground(white);
textcolor(black);
end;
Procedure UnderLine;
begin
textbackground(white);
textcolor(blue);
end;
Procedure Normal;
begin
textbackground(black);
textcolor(white);
end;
Procedure Goback;
begin
GotoXY(WhereX,WhereY-1);
ClrEol;
end;
Function Left( AnyString : string; Width : byte ) : string;
var
len : byte absolute AnyString;
loop : byte;
begin
while length( AnyString ) < Width do
AnyString:=AnyString+' ';
len:=Width; { truncate AnyString if Needed }
Left:=AnyString;
end;
Function Center( AnyString : string; Width : byte ) : string;
begin
repeat
if length( AnyString ) < Width
then AnyString:=AnyString+' ';
if length( AnyString ) < Width
then AnyString:=' '+AnyString;
until length( AnyString ) >= Width;
Center:=AnyString;
end;
Function ReadString( Prompt : string; Width : byte; var Escape : boolean ) : string;
var
NewString : string;
InKey,InKey2 : char;
Start : byte;
index : integer;
InsertMode : boolean;
Procedure Display;
begin
GotoXY(Start,WhereY);
if InverseOn
then Inverse;
write(left(NewString,Width));
if InverseOn
then Normal;
GotoXY(Start+index,WhereY);
end;
Procedure StripSpaces( var AnyString : string );
{ decrease length of AnyString until a character until a char other than a space is found }
begin
while AnyString[ ord(AnyString[0]) ]=' ' do
dec(AnyString[0]);
end; { Procedure }
begin
InsertMode:=false;
Start:=WhereX;
index:=0;
NewString:=Prompt;
Display;
index:=1;
if UpCaseOn
then Inkey:=UpCase(ReadKey)
else InKey:=ReadKey;
if InKey=#0
then begin
InKey2:=ReadKey;
if InKey2 in [#77,#82]
then NewString:=Prompt
else NewString:='';
if Inkey2=#82
then begin
InsertMode:=true;
index:=0;
end;
end { then }
else if InKey in ValidCharSet
then NewString:=InKey
else begin
NewString:='';
index:=0;
end;
if InKey=esc
then begin
ReadString:=Prompt;
Escape:=true;
ValidCharSet:=defaultSet;
exit;
end;
if InKey=#13
then begin
Escape:=false;
ReadString:=Prompt;
ValidCharSet:=DefaultSet;
exit;
end;
Display;
repeat
if UpCaseOn
then Inkey:=Upcase(readkey)
else InKey:=ReadKey;
if (InKey in ValidCharSet)
then begin
if not InsertMode
then Delete(NewString,index+1,1);
insert(InKey,NewString,index+1);
if index<> Width then inc(index)
end;
if (length(NewString)<>0) and (InKey=#8) { backspace }
then begin
Delete(NewString,index,1);
if index<>0
then dec(index);
end;
if InKey=#0
then begin
InKey:=ReadKey;
case InKey of
#77 : if (index<>length(NewString)) and (' ' in ValidCharSet)
then inc(index)
else if (index+1<>Width) and (' ' in ValidCharSet)
then begin
NewString:=NewString+' ';
inc(index);
end;
#75 : if index<>0
then if length(NewString)+1<>index
then dec(index)
else if NewString[index]=' '
then begin
NewString[0]:=succ(NewString[0]);
dec(index);
end
else dec(index);
#83 : if length(NewString)>0 then Delete(NewString,index+1,1);
#82 : if InsertMode
then InsertMode:=false
else InsertMode:=true;
end; { case }
end; { then }
if Length(NewString)>width then dec( NewString[0] );
if index >= width then dec(index);
Display;
until (InKey=#13) or (InKey=esc);
ValidCharSet:=DefaultSet;
if not ( (InKey=esc) or (length(NewString)=0))
then begin
StripSpaces(NewString);
ReadString:=NewString
end
else ReadString:=Prompt;
if InKey=esc
then Escape:=true
else Escape:=false;
end; { Procedure }
Function ReadNum( Prompt : real; Width : byte; var Escape : boolean ) : real;
var
NewString : string;
code : integer;
OldNum : real;
Start : byte;
begin
OldNum:=Prompt;
Start:=WhereX;
repeat
GotoXY(Start,WhereY);
str( Prompt:0:2, NewString );
ValidCharSet:=['0'..'9','.','-',' '];
NewString:=ReadString( NewString, Width, Escape );
val(NewString,Prompt,code);
until Escape or (code=0);
if Escape or (code<>0)
then ReadNum:=OldNum
else ReadNum:=Prompt;
end;
Function ReadInt( Prompt : longint; Width : byte; var Escape : boolean ) : longint;
var
NewString : string;
code : integer;
OldNum : longint;
Start : byte;
begin
OldNum:=Prompt;
Start:=WhereX;
repeat
GotoXY(Start,WhereY);
str( Prompt, NewString );
ValidCharSet:=['0'..'9','-',' '];
NewString:=ReadString( NewString, Width, Escape );
val(NewString,Prompt,code);
until Escape or (code=0);
if Escape
then ReadInt:=OldNum
else ReadInt:=Prompt;
end;
begin
InverseOn:=true;
UpcaseOn:=false;
ValidCharSet:=DefaultSet;
end.